home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / clisp-li.000 / clisp-li / clisp-1996-07-22 / src / gstream.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1996-06-08  |  4.8 KB  |  143 lines
  1. ;;; generic stream default methods
  2. ;;; Marcus Daniels 16.4.1994
  3.  
  4. (in-package "LISP")
  5. (export '(generic-stream-read-char
  6.           generic-stream-listen
  7.           generic-stream-clear-input
  8.           generic-stream-write-char
  9.           generic-stream-write-string
  10.           generic-stream-finish-output
  11.           generic-stream-force-output
  12.           generic-stream-clear-output
  13.           generic-stream-read-byte
  14.           generic-stream-write-byte
  15.           generic-stream-close
  16.           generic-stream-controller
  17. )        )
  18.  
  19. (in-package "SYSTEM")
  20.  
  21. (clos:defclass generic-stream-controller () ())
  22.  
  23. (clos:defgeneric generic-stream-read-char (controller))
  24. (clos:defgeneric generic-stream-listen (controller))
  25. (clos:defgeneric generic-stream-clear-input (controller))
  26. (clos:defgeneric generic-stream-write-char (controller ch))
  27. (clos:defgeneric generic-stream-write-string (controller string start len))
  28. (clos:defgeneric generic-stream-finish-output (controller))
  29. (clos:defgeneric generic-stream-force-output (controller))
  30. (clos:defgeneric generic-stream-clear-output (controller))
  31. (clos:defgeneric generic-stream-read-byte (controller))
  32. (clos:defgeneric generic-stream-write-byte (controller by))
  33. (clos:defgeneric generic-stream-close (controller))
  34.  
  35. (clos:defmethod generic-stream-read-char ((controller generic-stream-controller))
  36.   (declare (ignore controller))
  37. )
  38.  
  39. (clos:defmethod generic-stream-listen ((controller generic-stream-controller))
  40.   (declare (ignore controller))
  41. )
  42.  
  43. (clos:defmethod generic-stream-clear-input ((controller generic-stream-controller))
  44.   (declare (ignore controller))
  45. )
  46.  
  47. (clos:defmethod generic-stream-write-char ((controller generic-stream-controller) ch)
  48.   (declare (ignore controller ch))
  49. )
  50.  
  51. (clos:defmethod generic-stream-write-string ((controller generic-stream-controller) string start len)
  52.   (dotimes (i len)
  53.     (generic-stream-write-char controller (schar string (+ start i)))
  54. ) )
  55.  
  56. (clos:defmethod generic-stream-finish-output ((controller generic-stream-controller))
  57.   (declare (ignore controller))
  58. )
  59.  
  60. (clos:defmethod generic-stream-force-output ((controller generic-stream-controller))
  61.   (declare (ignore controller))
  62. )
  63.  
  64. (clos:defmethod generic-stream-clear-output ((controller generic-stream-controller))
  65.   (declare (ignore controller))
  66. )
  67.  
  68. (clos:defmethod generic-stream-read-byte ((controller generic-stream-controller))
  69.   (declare (ignore controller))
  70. )
  71.  
  72. (clos:defmethod generic-stream-write-byte ((controller generic-stream-controller) by)
  73.   (declare (ignore controller by))
  74. )
  75.  
  76. (clos:defmethod generic-stream-close ((controller generic-stream-controller))
  77.   (declare (ignore controller))
  78. )
  79.  
  80. #| ;; Example:
  81. ;; Alias streams just perform the required operation on another given stream.
  82. (defclass alias-controller (generic-stream-controller)
  83.   ((orig-stream :initarg :orig-stream))
  84. )
  85. (defun make-alias-stream (orig-stream)
  86.   (make-generic-stream
  87.     (make-instance 'alias-controller :orig-stream orig-stream)
  88. ) )
  89. (defmethod generic-stream-read-char ((controller alias-controller))
  90.   (with-slots (orig-stream) controller
  91.     (read-char orig-stream nil nil)
  92. ) )
  93. (defmethod generic-stream-listen ((controller alias-controller))
  94.   (with-slots (orig-stream) controller
  95.     (if (listen orig-stream)
  96.       0 ; something available
  97.       (let ((ch (read-char-no-hang orig-stream nil t)))
  98.         (cond ((eql ch t) -1) ; eof
  99.               ((null ch) +1) ; nothing available, not EOF
  100.               (t (unread-char ch orig-stream) 0) ; something available
  101. ) ) ) ) )
  102. (defmethod generic-stream-clear-input ((controller alias-controller))
  103.   (with-slots (orig-stream) controller
  104.     (clear-input orig-stream)
  105.     t
  106. ) )
  107. (defmethod generic-stream-write-char ((controller alias-controller) ch)
  108.   (with-slots (orig-stream) controller
  109.     (write-char ch orig-stream)
  110. ) )
  111. #| ; not needed, see general method above
  112. (defmethod generic-stream-write-string ((controller alias-controller) string start len)
  113.   (with-slots (orig-stream) controller
  114.     (dotimes (i len)
  115.       (write-char (schar string (+ start i)) orig-stream)
  116. ) ) )
  117. |#
  118. (defmethod generic-stream-finish-output ((controller alias-controller))
  119.   (with-slots (orig-stream) controller
  120.     (finish-output orig-stream)
  121. ) )
  122. (defmethod generic-stream-force-output ((controller alias-controller))
  123.   (with-slots (orig-stream) controller
  124.     (force-output orig-stream)
  125. ) )
  126. (defmethod generic-stream-clear-output ((controller alias-controller))
  127.   (with-slots (orig-stream) controller
  128.     (clear-output orig-stream)
  129. ) )
  130. (defmethod generic-stream-read-byte ((controller alias-controller))
  131.   (with-slots (orig-stream) controller
  132.     (read-byte orig-stream nil nil)
  133. ) )
  134. (defmethod generic-stream-write-byte (i (controller alias-controller))
  135.   (with-slots (orig-stream) controller
  136.     (write-byte i orig-stream)
  137. ) )
  138. (defmethod generic-stream-close ((controller alias-controller))
  139.   ; don't close orig-stream
  140. )
  141. |#
  142.  
  143.